Shareware Grab Bag/Shareware Grab Bag.iso/007/ptool.arc/PTOOLTIM.INC

Text File | 1985-06-06 | 12.4 KB | 364 lines

{ PTOOLTIM.INC   Copyright 1984  R D Ostrander                   Version 1.0
                                 Ostrander Data Services
                                 5437 Honey Manor Dr
                                 Indianapolis  IN  46241

 These Turbo Pascal functions are time manipulation tools used to Convert
 HH:MM:SS Strings, Change HH:MM:SS Strings to and from Decimal Days, Hours,
 Minutes, or Seconds, Add numbers to times, Find the difference between times,
 and to Retrieve the current (system) time.

 This program has been placed in the Public Domain by the author and copies
 may be freely made for non-commercial, demonstration, or evaluation purposes.
 Use of these subroutines in a program for sale or for commercial purposes in
 a place of business requires a $20 fee be paid to the author at the address
 above.  Personal non-commercial users may also elect to pay the $20 fee to
 encourage further development of this and similar programs. With payment you
 will be able to receive update notices, diskettes and printed documentation
 of this and other PTOOLs from Ostrander Data Services.


 PTOOL, and PTOOLxxx are Copyright Trademarks of Ostrander Data Services

 Turbo Pascal is a Copyright of Borland International Inc.

Functions available in PTOOLTIM.INC are:

                               (Result)

 PTTValid  (String)          : Boolean - True if argument is valid time
 PTTHtoD   (String)          : Real    - Convert argument (HH:MM:SS String) to
                                         a Decimal Time
 PTTDtoH   (Real)            : String  - Convert argument (Decimal Time) to a
                                         HH:MM:SS String
 PTTHtoH   (String)          : String  - Convert argument (HH:MM:SS String) to
                                         HH:MM:SS String in display format.
 PTTAdd    (String, Real)    : String  - Add argument-2 number of Days, Hours
                                         Minutes or Seconds (depending on
                                         Decimal Time Type) to argument-1
                                         (HH:MM:SS String) and express result
                                         as a HH:MM:SS String
 PTTComp  (String, String)  : Real    - Subtract argument-2 (HH:MM:SS String)
                                         from argument-1 (HH:MM:SS String)
                                         giving number of Days, Hours, Minutes
                                         or Seconds (depending on Decimal Time
                                         Type)
 PTTHCurr                    : String  - Current (system) Time as a HH:MM:SS
                                         String
 PTTDCurr                    : Real    - Current (system) Time as Decimal
                                         Days, Hours, Minutes or Seconds
                                         (depending on Decimal Time Type)   }



{ Constant Values  (Parameters) Begin Here ******************************** }


TYPE

     PTOOLTIM_Str_11   = String [11];
     PTOOLTIM_Elements = Array [1..4] of String [11];


CONST

   { HH:MM:SS String     A string expression of up to 11 characters.
     ---------------     example:  12:02:54 am

                         The style to display the elements (HH, MM, SS)
                         is determined by the parameters below.

                         As an argument, the time is passed as a string
                         expression with 3 or 4 elements separated by at
                         least one of the characters  / - , . ' ; : ( )
                         or a space.                                         }

                                           {   HH:MM:SS String parameters    }
                                           {*********************************}
 PTOOLTIM_HH_Disp   : Byte        = 12;    { Hour Display format             }
                                           {   12    = 12 hour format        }
                                           {   24    = 24 hour format        }
 PTOOLTIM_SS_Disp   : Char        = 'S';   { Seconds Display format          }
                                           {   'S'   = Display Seconds       }
                                           {   ' '   = Display HH:MM only    }
                                           {*********************************}


   { Decimal Time     A Real number in either of four formats:
     ------------        D = Decimal Days
                         H = Decimal Hours
                         M = Decimal Minutes
                         S = Decimal Seconds }

                                           {      Decimal Time parameter     }
                                           {*********************************}
 PTOOLTIM_D_Type    : Char        = 'M';   { Decimal Time Type               }
                                           {*********************************}


{ ****** Areas for internal use follow ****** }

 PTOOLTIM_Element   : PTOOLTIM_Elements = (' ', ' ', ' ', ' ');
 PTOOLTIM_NumH      : Integer = 0;
 PTOOLTIM_NumM      : Integer = 0;
 PTOOLTIM_NumS      : Integer = 0;



{ Internal Functions Begin Here ******************************************* }


Procedure PTOOLTIM_Parse (VAR Test               : PTOOLTIM_Str_11;
                          VAR Number_of_Elements : Integer);

Var
   I, J, K, E : Byte;                          { Get elements of input }
                                               { Any of the characters }
Begin                                          { below may seperate    }
     I := 1;                                   { the elements.         }
     K := 1;
     For E := 1 to 3 do
         Begin
              PTOOLTIM_Element [E] := ' ';
              While (not (Test [I] in ['0' .. '9']))
                and (I <= Length (Test)) do
                    Begin
                         PTOOLTIM_Element [4] [K] := Test [I];
                         K := K + 1;
                         I := I + 1;
                    End;
              J := 1;
              While (Test [I] in ['0' .. '9'])
                and (I <= Length (Test)) do
                    Begin
                         PTOOLTIM_Element [E] [J] := Test [I];
                         J := J + 1;
                         I := I + 1;
                         Number_of_Elements := E;
                         PTOOLTIM_Element [E] [0] := Char (J - 1);
                    End;
         End;
     While I <= Length (Test) do
           Begin
                PTOOLTIM_Element [4] [K] := Test [I];
                K := K + 1;
                I := I + 1;
           End;
     PTOOLTIM_Element [4] [0] := Char (K - 1);
End;



Function PTOOLTIM_H_Check (Test : PTOOLTIM_Str_11) : Boolean;

Var                                      { Find out if the Element areas     }
   Num_of_El : Integer;                  { represent a valid HH:MM:SS String }
   Code      : Integer;                  { and set Number areas              }

Begin
     PTOOLTIM_H_Check := True;
     PTOOLTIM_Parse (Test, Num_of_El);
     If (Num_of_El < 2) or
        (Num_of_El > 3) then
        PTOOLTIM_H_Check := False;
     Val (PTOOLTIM_Element [1], PTOOLTIM_NumH, Code);
     If Code <> 0 then PTOOLTIM_H_Check := False;
     Val (PTOOLTIM_Element [2], PTOOLTIM_NumM, Code);
     If Code <> 0 then PTOOLTIM_H_Check := False;
     PTOOLTIM_NumS := 0;
     If Num_of_El = 3 then
             Val (PTOOLTIM_Element [3], PTOOLTIM_NumS, Code);
     If (Pos ('p', PTOOLTIM_Element [4]) <> 0)
     or (Pos ('P', PTOOLTIM_Element [4]) <> 0) then
        If PTOOLTIM_NumH < 12  then
           PTOOLTIM_NumH := PTOOLTIM_NumH + 12
           else begin end
     else
        If PTOOLTIM_NumH = 12 then PTOOLTIM_NumH := PTOOLTIM_NumH - 12;
     If (PTOOLTIM_NumH > 23) or
        (PTOOLTIM_NumM > 59) or
        (PTOOLTIM_NumS > 59) or
        (PTOOLTIM_NumH < 0) or
        (PTOOLTIM_NumM < 0) or
        (PTOOLTIM_NumS < 0) then PTOOLTIM_H_Check := False;
End;


Function PTOOLTIM_Make_H : PTOOLTIM_Str_11;

Var                              { Transform the Number areas }
   Output : String [11];         { into a HH:MM:SS String     }
   Work   : String [2];

Begin
     Case PTOOLTIM_HH_Disp of
      12 : If PTOOLTIM_NumH > 12 then Str (PTOOLTIM_NumH - 12:2, Output)
           else
              If PTOOLTIM_NumH = 0 then Output := '12'
              else
                 Str (PTOOLTIM_NumH:2, Output);
      24 : Str (PTOOLTIM_NumH:2, Output);
      End; {Case}
     If Output [1] = ' ' then Delete (Output, 1, 1);
     Str (PTOOLTIM_NumM:2, Work);
     If Work [1] = ' ' then Work [1] := '0';
     Output := Output + ':' + Work;
     If PTOOLTIM_SS_Disp <> ' ' then
        Begin
             Str (PTOOLTIM_NumS:2, Work);
             If Work [1] = ' ' then Work [1] := '0';
             If PTOOLTIM_SS_Disp = 'S' then Output := Output + ':' + Work
                                       else Output := Output + '.' + Work;
        End;
     If PTOOLTIM_HH_Disp = 12 then
     If PTOOLTIM_NumH < 12 then Output := Output + ' am'
                           else Output := Output + ' pm';
     PTOOLTIM_Make_H := Output;
End;


Function PTOOLTIM_Get_D_Days : Real;  { Get Decimal Days from Number area }

Begin
     PTOOLTIM_Get_D_Days := (Int (PTOOLTIM_NumH) / 24)
                          + (Int (PTOOLTIM_NumM) / 1440)
                          + (Int (PTOOLTIM_NumS) / 86400.0);
End;


Function PTOOLTIM_Get_Decimal : Real;
                                        { Get Decimal time from }
Begin                                   { Number area           }
     Case PTOOLTIM_D_Type of
      'D' : PTOOLTIM_Get_Decimal := PTOOLTIM_Get_D_Days;
      'H' : PTOOLTIM_Get_Decimal := PTOOLTIM_Get_D_Days * 24;
      'M' : PTOOLTIM_Get_Decimal := PTOOLTIM_Get_D_Days * 1440;
      'S' : PTOOLTIM_Get_Decimal := PTOOLTIM_GET_D_Days * 86400.0;
      End; {Case}
End;



Procedure PTOOLTIM_Get_Time;
                                         { BIOS call to put current time }
Type                                     { into Number areas             }
    BiosCall = Record
               Ax, Bx, Cx, Dx, Bp, Si, Ds, Es, Flags : Integer;
               End;

Var
    BiosRec : BiosCall;
    Ah, Al  : Byte;

Begin
     Ah := $2c;
     With BiosRec do
          Begin
               Ax := Ah shl 8 + Al;
          End;
     Intr ($21, BiosRec);
     With BiosRec do
          Begin
               PTOOLTIM_NumH := Cx shr 8;
               PTOOLTIM_NumM := Cx mod 256;
               PTOOLTIM_NumS := Dx shr 8;
          End;
End;


{Called Functions Begin Here ******************************************** }


FUNCTION PTTValid (Test : PTOOLTIM_Str_11) : Boolean;

BEGIN

     PTTValid := PTOOLTIM_H_Check (Test);

END;


FUNCTION PTTHtoD (Input : PTOOLTIM_Str_11) : Real;

BEGIN

     If PTOOLTIM_H_Check (Input) then
        PTTHtoD := PTOOLTIM_Get_Decimal;

END;


FUNCTION PTTDtoH (Input : Real) : PTOOLTIM_Str_11;

BEGIN

     Case PTOOLTIM_D_Type of
      'H' : Input := Input / 24;
      'M' : Input := Input / 1440;
      'S' : Input := Input / 86400.0;
      End; {Case}
     Input := Frac (Input);
     PTOOLTIM_NumH := Trunc (Input * 24.001);
     PTOOLTIM_NumM := Trunc ((Input - (Int (PTOOLTIM_NumH) / 24)) * 1440.001);
     PTOOLTIM_NumS := Trunc ((Input - (Int (PTOOLTIM_NumH) / 24)
                                    - (Int (PTOOLTIM_NumM) / 1440))
                                        * 86400.001);
     PTTDtoH := PTOOLTIM_Make_H;

END;


FUNCTION PTTHtoH (Input : PTOOLTIM_Str_11) : PTOOLTIM_Str_11;

BEGIN

     If PTOOLTIM_H_Check (Input) then
        PTTHtoH := PTOOLTIM_Make_H;

END;


FUNCTION PTTAdd (Input : PTOOLTIM_Str_11;
                 Number : Real) : PTOOLTIM_Str_11;

BEGIN

     If PTOOLTIM_H_Check (Input) then
        PTTAdd := PTTDtoH (PTTHtoD (Input) + Number);

END;


FUNCTION PTTComp (Minuend, Subtrahend : PTOOLTIM_Str_11) : Real;

VAR

   HoldNum : Real;

BEGIN

     HoldNum := PTTHtoD (Minuend);
     PTTComp := HoldNum - PTTHtoD (Subtrahend);

END;


FUNCTION PTTHCurr : PTOOLTIM_Str_11;

BEGIN

     PTOOLTIM_Get_Time;
     PTTHCurr := PTOOLTIM_Make_H;

END;


FUNCTION PTTDCurr : Real;

BEGIN

     PTOOLTIM_Get_Time;
     PTTDCurr := PTOOLTIM_Get_Decimal;

END;